home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1999 April / macformat-075.iso / Shareware Plus / Applications / Alpha / Tcl / SystemCode / search.tcl < prev    next >
Encoding:
Text File  |  1999-01-31  |  19.6 KB  |  685 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Alpha - new Tcl folder configuration
  4.  # 
  5.  #  FILE: "search.tcl"
  6.  #                                    created: 13/6/95 {8:56:37 pm} 
  7.  #                                last update: 31/1/1999 {11:25:13 pm} 
  8.  #  
  9.  # Reorganisation carried out by Vince Darley with much help from Tom 
  10.  # Fetherston, Johan Linde and suggestions from the Alpha-D mailing list.  
  11.  # Alpha is shareware; please register with the author using the register 
  12.  # button in the about box.
  13.  #  
  14.  #  Description: 
  15.  # 
  16.  # All procedures which deal with search/reg-search/grep type stuff
  17.  # in Alpha.
  18.  # ###################################################################
  19.  ##
  20.  
  21. namespace eval text {}
  22. namespace eval quote {}
  23. namespace eval file {}
  24.  
  25. proc quickFind {} {isearch}
  26. proc reverseQuickFind {} {rsearch}
  27. proc quickFindRegexp {} {regIsearch}
  28.  
  29. #================================================================================
  30. # 'greplist' and 'grepfset' are used for batch searching from the "find" dialog.
  31. #  Hence, you really shouldn't mess with them unless you know what you are doing.
  32. #================================================================================
  33. proc greplist {args} {
  34.     global tileLeft tileTop tileWidth tileHeight errorHeight
  35.     
  36.     set recurse [lindex $args 0]
  37.     set word [lindex $args 1]
  38.     set args [lrange $args 2 end]
  39.     
  40.     set num [expr {[llength $args] - 2}]
  41.     set exp [lindex $args $num]
  42.     set arglist [lindex $args [expr {$num + 1}]]
  43.     
  44.     set opened 0
  45.     set owin 0
  46.     set cid [scancontext create]
  47.     
  48.     set cmd [lrange $args 0 [expr {$num - 1}]]
  49.     eval scanmatch $cmd {$cid $exp {
  50.     if {!$word || [regexp -nocase -- "(^|\[^a-zA-Z0-9\])${exp}(\[^a-zA-Z0-9\]|\$)" $matchInfo(line)]} {
  51.         if {!$owin} {
  52.         set owin 1
  53.         win::SetProportions
  54.         set w [new -n {* Batch Find *} -m Brws -g $tileLeft $tileTop $tileWidth $errorHeight]
  55.         insertText "(<cr> to go to match)\r-----\r"
  56.         set opened 1
  57.         }
  58.         set l [expr 20 - [string length [file tail $f]]]
  59.         insertText -w $w "\"[file tail $f]\"[format "%$l\s" ""]; Line $matchInfo(linenum): $matchInfo(line)\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f\r"}
  60.     }
  61.     }
  62.     
  63.     foreach f $arglist {
  64.     message [file tail $f]
  65.     if {![catch {set fid [open $f]}]} {
  66.         scanfile $cid $fid
  67.         close $fid
  68.     }
  69.     }
  70.     scancontext delete $cid
  71.     
  72.     if {$opened} {
  73.     select [nextLineStart [nextLineStart [minPos]]] [nextLineStart [nextLineStart [nextLineStart [minPos]]]]
  74.     setWinInfo dirty 0
  75.     setWinInfo read-only 1
  76.     }
  77.     message ""
  78. }
  79.  
  80.  
  81. ## 
  82.  # -------------------------------------------------------------------------
  83.  # 
  84.  # "grepfset" --
  85.  # 
  86.  #  args: wordmatch ?-nocase? expression fileset
  87.  #  Obviously we ignore wordmatch
  88.  #  
  89.  #  If the 'Grep' box was set, then the search item is _not_ quoted.
  90.  #  
  91.  #  Non grep searching problems:
  92.  #  
  93.  #  If it wasn't set, then some backslash quoting takes place. 
  94.  #  (The chars: \.+*[]$^ are all quoted)
  95.  #  Unfortunately, this latter case is done incorrectly, so most
  96.  #  non-grep searches which contain a grep-sensitive character fail.
  97.  #  The quoting should use the equivalent of the procedure 'quote::Regfind'
  98.  #  but it doesn't quote () and perhaps other important characters.
  99.  #  
  100.  #  Even worse, if the string contained any '{' it never reaches this
  101.  #  procedure (there must be an internal error due to bad quoting).
  102.  # 
  103.  # -------------------------------------------------------------------------
  104.  ##
  105. proc grepfset {args} {
  106.     set num [expr {[llength $args] - 2}]
  107.     # the 'find' expression
  108.     set exp [lindex $args $num]
  109.     # the fileset
  110.     set fset [lindex $args [expr {$num + 1}]]
  111.     eval greplist 0 [lrange $args 0 [expr {$num-1}]] {$exp [getFileSet $fset]}
  112. }
  113.  
  114. proc grep {exp args} {
  115.     set files {}
  116.     foreach arg $args {
  117.     eval lappend files [glob -t TEXT -nocomplain $arg]
  118.     }
  119.     if {![llength $files]} {return "No files matched pattern"}
  120.     set cid [scancontext create]
  121.     scanmatch $cid $exp {
  122.     if {!$blah} {
  123.         set blah 1
  124.         set lines "(<cr> to go to match)\n"
  125.     }
  126.     set l [expr 20 - [string length [file tail $f]]]
  127.     append lines "\"[file tail $f]\"[format "%$l\s" ""]; Line $matchInfo(linenum): $matchInfo(line)\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f\n"
  128.     }
  129.     
  130.     set blah 0
  131.     set lines ""
  132.     
  133.     foreach f $files {
  134.     if {![catch {set fid [open $f]}]} {
  135.         message [file tail $f]
  136.         scanfile $cid $fid
  137.         close $fid
  138.     }
  139.     }
  140.     scancontext delete $cid
  141.     return [string trimright $lines "\r"]
  142. }
  143.  
  144. proc grepnames {exp args} {
  145.     set files {}
  146.     foreach arg $args {
  147.     eval lappend files [glob -t TEXT -nocomplain $arg]
  148.     }
  149.     if {![llength $files]} {return "No files matched pattern"}
  150.     set cid [scancontext create]
  151.     scanmatch $cid $exp {
  152.     lappend filenames $f
  153.     }
  154.     set filenames ""
  155.     foreach f $files {
  156.     if {![catch {set fid [open $f]}]} {
  157.         message [file tail $f]
  158.         scanfile $cid $fid
  159.         close $fid
  160.     }
  161.     }
  162.     scancontext delete $cid
  163.     return $filenames
  164. }
  165.  
  166. ## 
  167.  # -------------------------------------------------------------------------
  168.  # 
  169.  # "grepsToWindow" --
  170.  # 
  171.  #  'args' is a list of items
  172.  # -------------------------------------------------------------------------
  173.  ##
  174. proc grepsToWindow {title args} {
  175.     global tileLeft tileTop tileWidth tileHeight errorHeight
  176.     win::SetProportions
  177.     new -n $title -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws \
  178.       -info [join $args ""]
  179.     select [nextLineStart [nextLineStart [minPos]]] [nextLineStart [nextLineStart [nextLineStart [minPos]]]]
  180.     message ""
  181. }
  182.  
  183. proc findBatch {forward ignore regexp word pat} {
  184.     matchingLines $pat $forward $ignore $word $regexp 
  185. }
  186.  
  187. ## 
  188.  # -------------------------------------------------------------------------
  189.  #     
  190.  #    "containsSpace"    --
  191.  #    
  192.  #     Does the given    text contain any spaces?  In general we    don't complete
  193.  #     commands which    contain    spaces (although perhaps future    extensions
  194.  #     should    do this: e.g. cycle    through    'string    match',    'string    compare',…)
  195.  # -------------------------------------------------------------------------
  196.  ##
  197. proc containsSpace { cmd } { return [string match "*\[ \t\]*" $cmd] }
  198. proc containsReturn { cmd } { return [string match "*\[\r\n\]*" $cmd] }
  199.  
  200. ## 
  201.  # -------------------------------------------------------------------------
  202.  #     
  203.  #    "findPatJustBefore"    --
  204.  #    
  205.  #     Utility proc to check whether the first occurrence    of 'findpat'
  206.  #     to    the    left of    'pos' is actually an occurrence    of 'pat'. It can
  207.  #     be    used to    check if we're part    of an '} else {' (see TclelectricLeft)
  208.  #     or    in TeX mode    if we're in    the    argument of    a '\label{'    or '\ref{'
  209.  #     (see smartScripts)    for    example.
  210.  #     
  211.  #     A typical usage has the regexp    'pat' end in '$', so that it must
  212.  #     match all the text    up to 'pos'.  'matchw' can be used to store
  213.  #     the first '()'    pair match in the regexp.
  214.  #     
  215.  #     New: maxlook restricts how far this proc will search.  The default
  216.  #     is only 100 (not the entire file), after all this proc is supposed
  217.  #     to look 'just before'!
  218.  # -------------------------------------------------------------------------
  219.  ##
  220. proc findPatJustBefore { findpat pat {pos ""} {matchw ""} {maxlook 100} } {
  221.     if { $pos == "" } {set pos [getPos] }
  222.     if { $pos == [maxPos]} { set pos [pos::math $pos - 1]}
  223.     if { $matchw != "" } { upvar $matchw word }
  224.     if {[llength [set res [search -s -n -f 0 -r 1 -l [pos::math $pos - $maxlook] -- "$findpat" $pos]]]} {
  225.     if {[regexp "$pat" [getText [lindex $res 0] $pos] dum word]} {
  226.         return [lindex $res 0]
  227.     }
  228.     }
  229.     return
  230. }
  231. # Look for pattern in filename after position afterPos and, if found, 
  232. # open the file quietly and select the pattern
  233. # author Jonathan Guyer
  234. proc selectPatternInFile {filename pattern {afterPos ""}} {
  235.     if {$afterPos == ""} {set afterPos [minPos]}
  236.     set searchResult [searchInFile $filename $pattern 1]
  237.     if {[pos::compare [lindex $searchResult 0] >= $afterPos]} {
  238.     placeBookmark
  239.     file::openQuietly $filename
  240.     eval select $searchResult
  241.     message "press <Ctl .> to return to original cursor position"
  242.     return 1
  243.     } else {
  244.     return 0
  245.     }
  246. }
  247.  
  248. proc text::replace {old new {fwd 1} {pos ""}} {
  249.     if {$pos == ""} {set pos [getPos]}
  250.     set m [search -s -f $fwd -m 0 -r 0 -- $old $pos]
  251.     eval replaceText $m [list $new]
  252. }
  253.  
  254. proc isSelection {} {
  255.     return [pos::compare [getPos] != [selEnd]]
  256. }
  257. proc searchStart {} {
  258.     global search_start
  259.     select [getPos]
  260.     setMark
  261.     if {[catch {goto $search_start}]} {message "No previous search"}
  262. }
  263. set {patternLibrary(Pascal to C Comments)}      { {\{([^\}]*)\}}    {/* \1 */}     }
  264. set {patternLibrary(C++ to C Comments)}            { {//(.*)}            {/* \1 */}     }
  265. set {patternLibrary(Space Runs to Tabs)}        { { +}                {\t}         }
  266.  
  267. proc getPatternLibrary {} {
  268.     global patternLibrary
  269.     
  270.     foreach nm [array names patternLibrary] {
  271.     lappend nms [concat [list $nm] $patternLibrary($nm)]
  272.     }
  273.     return $nms
  274. }
  275.  
  276. # This fails if, say, search string is '\{[^}]'
  277. # This is because the '}' ends the first argument because this
  278. # procedure is presumably called internally with incorrect quoting.
  279. proc rememberPatternHook {search replace} {
  280.     global patternLibrary modifiedArrayElements
  281.     if {[catch {set name [prompt "New pattern's name?" ""]}]} {
  282.     return ""
  283.     }
  284.     lappend modifiedArrayElements [list $name patternLibrary]
  285.     set patternLibrary($name) [list $search $replace]
  286.     return $name
  287. }
  288.  
  289. proc deletePatternHook {} {
  290.     global patternLibrary modifiedArrayElements
  291.     set temp [list prompt "Delete which pattern?" [lindex [array names patternLibrary] 0] "Pats:"]
  292.     set name [eval [concat $temp [array names patternLibrary]]]
  293.     lappend modifiedArrayElements [list $name patternLibrary]
  294.     unset patternLibrary($name)
  295. }
  296.  
  297. ## 
  298.  # -------------------------------------------------------------------------
  299.  # 
  300.  # "regIsearch" -- REGular expression Iterative SEARCH
  301.  # 
  302.  # This version allows class shorthands (\d \s \w \D \S \W), 
  303.  # word anchors (\b), and some aliases of the machine dependent 
  304.  # control characters (\a \f \e \n \r \t). Therefore, 
  305.  # we need two prompts, one for when we have a valid pattern, and one 
  306.  # for when the pattern has gone invalid (most likely due to starting 
  307.  # to enter one of the above patterns). 
  308.  # 
  309.  # The Return key aborts it  and the point goes back to the 
  310.  # original $pos. You can then use 'exchangePointAndMark' 
  311.  # (cntrl-x, cntrl-x -in emacs keyset) to jump back and forth 
  312.  # between where the search started from, to where the search was
  313.  # ended.
  314.  # 
  315.  # The Escape key or Mouse-click "exits" it, (as does "abortEm" -bound 
  316.  # to cntrl-g), as well as most modifier-key-combinations
  317.  # (except for Shift, and any combination whose  binding's 
  318.  # functionality makes sense -see regComp below). Also the 
  319.  # up & down Arrow keys, exit it. An exit differs from an abort in that, 
  320.  # in the former, the selection is left at the last search result.
  321.  # 
  322.  # 
  323.  # The next occurrence of the current pattern can be matched by typing 
  324.  # either control-s (to get the next occurence forward), or control-r 
  325.  # (to get the the next occurrence backward)
  326.  #
  327.  # Also, after aborting, the search string is left in the Find dialog,
  328.  # and so you can use 'findAgain', but, be aware that the Find dialog
  329.  # starts out with a default of <Grep=OFF>.
  330.  #  
  331.  # Original Author: Mark Nagata
  332.  # modifications  : Tom Fetherston
  333.  # -------------------------------------------------------------------------
  334.  ##
  335. proc regIsearch {} {
  336.     
  337.     set ignoreCase 0
  338.     set patt ""
  339.     set pos [getPos]
  340.     
  341.     set done 0
  342.     while {!$done} {
  343.     # check pattern validatity
  344.     if {[catch {regexp -- $patt {} dmy} dmy]} {        
  345.         set prompt "building->: $patt"
  346.     } else {
  347.         set prompt "regIsearch: $patt"
  348.     } 
  349.     switch -- [catch {status::prompt $prompt regComp "anything"} res] {
  350.         0 {
  351.         # got a keystroke that triggered a normal end (e.g. <return>)
  352.         goto $pos
  353.         message "Aborted: $patt"
  354.         return
  355.         }
  356.         1 {
  357.         # an error was generated
  358.         if {[string match "missing close-brace" $res]} {
  359.             # must have typed a slash, so:
  360.             append patt "\\"
  361.             continue
  362.         } else {
  363.             # alertnote $res
  364.             set done 1
  365.         }
  366.         
  367.         }
  368.         default {
  369.         set done 1
  370.         }
  371.     }
  372.     
  373.     }
  374.     
  375.     message " Exited: $patt"
  376. }
  377.  
  378.  
  379. ## 
  380.  # -------------------------------------------------------------------------
  381.  # 
  382.  # "regComp" -- REGisearch COMmand line input character Processor
  383.  # 
  384.  #  This proc handles each keypress while running a regIsearch. It has been 
  385.  #  modified from Mark Nagata's original to provide next ocurrence 
  386.  #  before/after current, and support for key bindings whose navigation or 
  387.  #  text manipulation functionality makes sense with respect to a regIsearch.
  388.  #  
  389.  #  closest occurence before current match    
  390.  #    - command-option g & cntrl-r (mnemonic 'reverse')
  391.  #  closest occurence after current match
  392.  #    - command g & cntrl-s (mnemonic 'successor')
  393.  #  
  394.  #                         Text Naviagation
  395.  #  forwardChar (aborts and leaves cursor after last match)
  396.  #    - right arrow & cntrl-f (emacs)
  397.  #  backwardChar (aborts and leaves cursor before last match)
  398.  #    - left arrow & cntrl-b (emacs)
  399.  #  beginningOfLine (aborts and moves cursors to the start of the line 
  400.  #      containing the last match)
  401.  #    - cmd left arrow & cntrl-a (emacs)
  402.  #  beginningOfLine (aborts and moves cursors to the start of the line 
  403.  #      containing the last match)
  404.  #    - cmd right arrow & cntrl-e (emacs)
  405.  #  
  406.  #                         Text Manipulation
  407.  #  deleteSelection (aborts and deletes selection)
  408.  #    - cntrl-d (emacs)
  409.  #  killLine (aborts and deletes from start of selection to end of line)
  410.  #    - cntrl-k (emacs)
  411.  #  
  412.  # -------------------------------------------------------------------------
  413.  ##
  414. proc regComp {curr {key 0} {mod 0}} {
  415.     set direction {}
  416.     
  417.     # build a string that represents all the modifiers pressed:
  418.     # checking in this order cmd, shift, option, and ctrl
  419.     if {[expr {$mod & 1}]} { append t "c" } else { append t "_" }
  420.     if {[expr {$mod & 34}]} { append t "s" } else { append t "_" }
  421.     if {[expr {$mod & 72}]} { append t "o" } else { append t "_" }
  422.     if {[expr {$mod & 144}]} { append t "z" } else { append t "_" }
  423.     
  424.     scan $key %c decVal
  425.     
  426.     switch -- $t {
  427.     "____" {
  428.         switch -- $decVal {
  429.         29 {forwardChar ;         break; # right arrow; }
  430.         28 {backwardChar ;         break; # left arrow; }
  431.         30 {                        break; # up arrow; }
  432.         31 {                        break; # down arrow; }
  433.         }
  434.     }
  435.     }
  436.     
  437.     switch -- $t {
  438.     "____" - 
  439.     "_s__" {
  440.         upvar patt pat
  441.         if {$curr != ""} {
  442.         while {[string compare [string range $pat [string last $curr $pat] end] $curr] != 0} {
  443.             set newEnd [expr {[string length $pat] - 2}]
  444.             if {$newEnd < 0} {
  445.             error "deleted past string start"
  446.             } 
  447.             set pat [string range $pat 0 $newEnd] 
  448.         }
  449.         } 
  450.         
  451.         set preAppend $pat
  452.         append pat $key
  453.         if {[catch {regexp $pat {} dmy} res]} {
  454.         message "building->: $preAppend"
  455.         } else {
  456.         message "regIsearch: $preAppend" 
  457.         upvar ignoreCase ign
  458.         set searchResult [search -n -f 1 -m 0 -i $ign -r 1 -- $pat [getPos]]
  459.         if {[llength $searchResult] == 0} {
  460.             beep
  461.         } else {
  462.             select [lindex $searchResult 0] [lindex $searchResult 1]
  463.         }
  464.         } 
  465.         return $key
  466.         
  467.     }
  468.     "c___" {
  469.         switch -- $decVal {
  470.         103 { set direction fwd;        # (cmd g); }
  471.         28 {beginningOfLine ;     break; # cmd left arrow; }
  472.         29 {endOfLine ;         break; # cmd right arrow; }
  473.         }
  474.         
  475.     }
  476.     "___z" {
  477.         # If the user is using the emacs key bindings, check for ones that 
  478.         # make sense. All other control key combinations abort
  479.         if {[package::active emacs]} {
  480.         switch -- $decVal {
  481.             6 {forwardChar ;         break; # cntrl-f; }
  482.             2 {backwardChar ;     break; # cntrl-b; }
  483.             1 {beginningOfLine ;     break; # cntrl-a; }
  484.             5 {endOfLine ;         break; # cntrl-e; }
  485.             4 {deleteSelection ;     break; # cntrl-d; }
  486.             10 {killLine ;         break; # cntrl-k; }
  487.         }
  488.         } 
  489.         # See if user has requested to find another match, either searchForward 
  490.         # (cntrl-s) or reverseSearch (cntrl-r). Set flag accordingly
  491.         switch -- $decVal {
  492.         115 - 19 { set direction fwd; # (cntrl-s); }
  493.         114 - 18 { set direction bckwd; # (cntrl-r); }
  494.         default {return {} }
  495.         }
  496.     }
  497.     "c_o_" {
  498.         switch $decVal {
  499.         169 { set direction bckwd; # (cmd-opt 'g'); }
  500.         default {return {} }
  501.         }
  502.         
  503.     }
  504.     "default" {
  505.         beep
  506.         error "modifier combination has no meaningful bindings with respect to regIsearch"
  507.     }
  508.     }
  509.     # handle direction flag if it got set above
  510.     if {$direction != ""} {
  511.     upvar patt pat
  512.     upvar ignoreCase ign
  513.     if {[string match $direction fwd]} {
  514.         set dir 1
  515.         set search_start [pos::math [getPos] + 1]
  516.     } else {
  517.         set dir 0
  518.         set search_start [pos::math [getPos] - 1]
  519.     } 
  520.     set searchResult [search -n -f $dir -m 0 -i $ign -r 1 -- $pat $search_start]
  521.     if {[llength $searchResult] == 0} {
  522.         beep
  523.     } else {
  524.         select [lindex $searchResult 0] [lindex $searchResult 1]
  525.     }
  526.     return {}
  527.     } 
  528. }
  529.  
  530.  
  531. proc choicesProc {curr c} {
  532.     global choiceList
  533.     if {$c != "\t"} {return $c}
  534.     
  535.     set matches {}
  536.     foreach w $choiceList {
  537.         if {[string match "$curr*" $w]} {
  538.             lappend matches $w
  539.         }
  540.     }
  541.     if {![llength $matches]} {
  542.         beep
  543.     } else {
  544.         return [string range [largestPrefix $matches] [string length $curr] end]
  545.     }
  546.     return ""
  547. }
  548.  
  549.  
  550. proc sPromptChoices {msg def choiceListIn} {
  551.     global useStatusBar choiceList
  552.     set choiceList $choiceListIn
  553.     if {[catch {statusPrompt -f "$msg ($def): " choicesProc} ans]} {
  554.     error "cancel"
  555.     }
  556.     if {![string length $ans]} {return $def}
  557.     return $ans
  558. }
  559.  
  560. proc nextFunc {} {
  561.     searchFunc 1
  562. }
  563.  
  564. proc prevFunc {} {
  565.     searchFunc 0
  566. }
  567.  
  568. proc jumpNextFunc {} {
  569.     searchFunc 3
  570. }
  571.  
  572. proc jumpPrevFunc {} {
  573.     searchFunc 2
  574. }
  575.  
  576. proc searchFunc {code} {
  577.     set pos [getPos]
  578.     
  579.     #to allow us to handle special cases
  580.     set funcExpr [get_funcExpr $code]
  581.     
  582.     select $pos
  583.     
  584.     switch $code {
  585.       "1" -
  586.       "3" {
  587.         set pos [pos::math $pos + 1]
  588.         set lastStop [maxPos]
  589.         set dir 1
  590.       }
  591.       "0" -
  592.       "2" {
  593.         set pos [pos::math $pos - 1]
  594.         set lastStop 0
  595.         set dir 0
  596.       }
  597.     }
  598.  
  599.     if {![catch {search -s -f $dir -i 1 -r 1 -- $funcExpr $pos} res]} {
  600.         eval select $res
  601.     } elseif {$code == 3} {
  602.         searchFunc 1
  603.     } else {
  604.         goto $lastStop
  605.         switch $dir {
  606.         0 {
  607.         message "At top, no more functions in this direction"
  608.         }
  609.         1 {
  610.         message "At bottom, no more functions in this direction"
  611.         }
  612.     }
  613.     }
  614. }
  615.  
  616. proc get_funcExpr {dir} {
  617.     global funcExpr mode
  618.     switch $mode {
  619.       "Tcl" {
  620.         if {[regexp "^\\* Trace" [win::CurrentTail]]} {
  621.             switch $dir {
  622.               "0" -
  623.               "1" {
  624.                 set searchExpr {(^ *[\w:]+ $)|(^ *[^ ']+ ')}
  625.               }
  626.               "2" {
  627.                 if {[regexp {(^.*)OK:} [getSelect] blah searchExpr]} {
  628.                     set searchExpr "^${searchExpr}"
  629.                 } else {
  630.                     set searchExpr {(^ *[\w:]+ $)|(^ *[^ ']+ ')}
  631.                 }
  632.               }
  633.               "3" {
  634.                 regexp {(^[^']*)'?} [getSelect] blah searchExpr
  635.                 set searchExpr "^${searchExpr}OK:"
  636.               }
  637.             }
  638.         } else {
  639.             set searchExpr $funcExpr 
  640.         } 
  641.       }
  642.       "default" {
  643.         set searchExpr $funcExpr 
  644.       }
  645.     }
  646.     return $searchExpr     
  647. }
  648.  
  649. proc sPrompt {msg def} {
  650.     global useStatusBar
  651.     if {!$useStatusBar} {return [prompt $msg $def]}
  652.     if {[catch {statusPrompt "$msg ($def): "} ans]} {
  653.         error "cancel"
  654.     }
  655.     if {![string length $ans]} {return $def}
  656.     return $ans
  657. }
  658.  
  659. ###
  660. #===========================================================================
  661. # Juan Falgueras (7/Abril/93)
  662. # you only need to select (or not) text and move *forward and backward*
  663. # faster than iSearch (if you have there the |word wo|rd..).
  664. #===========================================================================
  665.  
  666. proc quickSearch {dir} {
  667.     if {[pos::compare [selEnd] == [getPos]]} {
  668.         backwardChar
  669.         hiliteWord
  670.     }
  671.     set myPos [expr {$dir ? [selEnd] : [pos::math [getPos] - 1]}]
  672.     set text [getSelect]
  673.     set searchResult [search -s -n -f $dir -m 0 -i 1 -r 0 $text $myPos]
  674.     if {[llength $searchResult] == 0} {
  675.         beep
  676.         message [concat [expr {$dir ? "->" : "<-"}] '$text' " not found"]
  677.         return 0
  678.     } else {
  679.         message [concat [expr {$dir ? "->" : "<-"}] '$text']
  680.         eval select $searchResult
  681.         return 1
  682.     }
  683. }
  684.  
  685.